
=head2 Sgdb::LocalConfig

  this file should contain any local configuration data or functions  and
 should be modified for special installations.

  in order to share this file with simple scripts, this file should
 be 'old perl' compatible

=cut


package Sgdb::LocalConfig ;
use 5.6.0 ;
use strict ;
use warnings ;
use bytes ;

use FileHandle ;
use File::Basename ;
use File::Spec ;

# my $remotegui ;
BEGIN {
    $ENV{USER}    ||= $ENV{USERNAME}   || 'anonymous' ;
    $ENV{HOME} = ( $^O eq 'MSWin32' ? 'c:' : '.' ) unless $ENV{HOME} and -d $ENV{HOME} ;
    $ENV{DISPLAY} ||= ':0' ;
    $ENV{HOST}    ||= $ENV{USERDOMAIN} || eval {require Sys::Hostname ; Sys::Hostname::hostname() } || 'unknown' ;
    $ENV{PWD}     ||= eval {require Cwd ; getcwd() } ;
    $ENV{PWD}     ||=  './' ; # good luck
}

sub whereami {
    # my $N = '/sgdb/sgdb.local/NAME' ;
    # if (-f $N) {
    #     open F, $N or die "can't open $N: $!\n" ;
    #     local $/ ;
    #     <F> =~ /(\w+)/ and $ENV{SGDBLOCAL} = $1 ;
    #     return '/sgdb' ;
    # }
    # if (-d '/emc/sgdb'){
    #     return '/emc/sgdb' ;
    # }
    ( $0 =~ m[(.*/)] )
#    '.' ;
}

sub my_dir_dirs() {

    my $sgdbhome = whereami() ;

    return                      # automount should do the work
      (map { my $d = "$sgdbhome/$_" ; (-d $d) ? $d : $sgdbhome }
       qw{ sbin share Data Gallery PSE})
        if -d $sgdbhome ;

    my $d = File::Basename::dirname $0 ;
    return
      ($d, $d, $d, '', '.' ) ;
}
my ($sbin, $share, $data, $gallery, $pse ) = &my_dir_dirs ;

my %local_config =
    (
     # architecture depended values
     # 'gdb-linux-ppc'       => "$sbin/gdb-linux-ppc",
     # 'gdb-sun-ppc'         => "$sbin/gdb-sun-ppc",
     # 
     # 
     # 'gdb-win32-ppc'       => "$sbin\\gdb-ppc.exe" ,
     # 'gdb-linux-2.2-ppc'   => '/emc/ucode/sdp/sgdb6/gdb-linux-ppc',
     # 
     # 'gdb-linux-m68'       => "$sbin/gdb-linux-m68",
     # 'gdb-sun-m68'         => "$sbin/gdb-sun-m68",
     # 'gdb-win32-m68'       => "$sbin\\gdb-m68.exe",
     # 
     # 'gdb-linux-x86'       => "$sbin/gdb-linux-x86",
     # 'gdb-linux-x86_64'    => "$sbin/gdb-linux-x86_64",
     # 'gdb-linux-linux'     => "$sbin/gdb-linux-linux",
     # 'gdb-sun-sun'         => "$sbin/gdb-sun-sun",
     # 'gdb-win32-win32'     => "$sbin\\gdb.exe",
     # 
     # 'gdb-sun-x86'         => "$sbin/gdb-sun-x86" ,
     # 'gdb-sun-x86_64'      => "$sbin/gdb-sun-x86_64" ,
     # 'gdb-pcsolaris-x86'   => "$sbin/gdb-pcsolaris-x86",

     'gdb-default'         => "gdb",
     'gdb'                 => 'gdb',

     # 'gdb53-sun-ppc'       => "$sbin/gdb5.3-sun-ppc",
     # 'gdb53-linux-ppc'     => "$sbin/gdb5.3-linux-ppc",

#      ($ENV{SGDBTK_DEBUG} ?
#       ( 'gdb-linux-x86' => "$sbin/gdb6.8-linux-386",
#         'gdb-sun-x86'   => "$sbin/gdb6.8-sun-386",
#       ) : () ),

     'chdir-luncher'       => "$sbin/chdir-luncher.pl",
     # 'bin-uploader'        => "$sbin/bin-uploader.pl",
     # 'symm-image-pl'       => "$sbin/symm.image.pl",
     # 'symm-image'          => \&get_symm_image,
     # 
     # 'cvs-sun'             => '/emc/ucode/SunOS-5x-sun4/bin/cvs',
     # 'cvs-linux'           => '/emc/ucode/Linux-2x-i686/bin/cvs',
     # 'cvs-pcsolaris'       => "$sbin/cvs-pcsolaris",
     # 
     # 'readelf-sun'         => "$sbin/readelf-sun",
     # 'readelf-sun-5.5.1'   => "$sbin/readelf-sun",
     # 'readelf-linux'       => "$sbin/readelf-linux",
     # 'readelf-pcsolaris'   => "$sbin/readelf-pcsolaris",
     'readelf' => 'readelf',
     # 
     # 'objdump-sun-ppc'     => "$sbin/objdump-sun-ppc",
     # 'objdump-linux-ppc'   => "$sbin/objdump-linux-ppc",
     # 'objdump-linux-x86'   => "$sbin/objdump-linux",
     # 'objdump-sun'         => "$sbin/objdump-sun",
     # 'objdump-sun-x86'     => "$sbin/objdump-sun-386",
     # 'objdump-pcsolaris'   => "$sbin/objdump-pcsolaris",
     'objdump'             => 'objdump',

     'gcc'                 => 'gcc',
     # 'gcc-linux-ppc'       => '/emc/ucode/Linux-2x-i686/v3.4.6-2006-08-23/bin/powerpc-emc-eabi-gcc',
     # 'gcc-linux-x86'       => '/emc/ucode/Linux-2x-i686/v3.4.6-2006-08-23/bin/i686-emc-elf-gcc',
     # 'gcc-sun-ppc'         => '/emc/ucode/SunOS-5x-sun4/current/bin/powerpc-elf-eabi-gcc',
     # 'gcc-sun-x86'         => '/emc/ucode/SunOS-5x-sun4/v11012003/bin/i686-unknown-elf-gcc',

     # 'symmnat-sun'         => "$sbin/symmnat-sun",
     # 'symmnat-linux'       => "$sbin/symmnat-linux",
#      'symmnat-win32'       => "$sbin\\dummy.bat",

     # 'patch-sun'           => "$sbin/patch-sun",
     # 'patch-linux'         => "$sbin/patch-linux",
     # 'patch-win32'         => "$sbin\\patch.exe",
     # 'patch-pcsolaris'     => "$sbin/patch-pcsolaris",
     # 
     # 'diff-sun'            => "$sbin/diff-sun",
     # 'diff-linux'          => "$sbin/diff-linux",
     # 'diff-linux-2.2'      => "$sbin/diff-linux-2.2",
     # 'diff-pcsolaris'      => "$sbin/diff-pcsolaris",

     # 'unzip-sun'           => "$sbin/unzip-sun",
     # 'unzip-linux'         => "$sbin/unzip-linux",
     # 'unzip-win32'         => "$sbin\\unzip.exe",
     # 'unzip-pcsolaris'     => "$sbin/unzip-pcsolaris",

     # 'syreninfo-sun'       => "$sbin/syreninfo-sun",
     # 'syreninfo-linux'     => "$sbin/syreninfo-linux",
     # 'syreninfo-pcsolaris' => "$sbin/syreninfo-pcsolaris",
     # 
     # 'syscall-sun'         => "$sbin/syscall-sun",
     # 'syscall-linux'       => "$sbin/syscall-linux",
     # 'syscall-pcsolaris'   => "$sbin/syscall-pcsolaris",
     # 
     # 'inq-sun'             => "$sbin/inq-sun",
     # 'inq-linux'           => "$sbin/inq-linux",
     # 'inq-pcsolaris'       => "$sbin/inq-pcsolaris",
     # 
     # 'symdev-sun'          => "$sbin/symdev-sun",
     # 'symdev-linux'        => "$sbin/symdev-linux",
     # 'symdev-pcsolaris'    => "$sbin/symdev-pcsolaris",
     # 
     # 'smbclient-sun'       => "$sbin/smbclient-sun",
     # 'smbclient-linux'     => "$sbin/smbclient-linux" ,
     # 
     # 'finger-sun'          => "$sbin/finger-sun",
     # 'finger-linux'        => "$sbin/finger-linux",
     # 'finger-pcsolaris'    => "$sbin/finger-pcsolaris",
     # 
     # 'addr2line-linux'     => "$sbin/addr2line-linux",
     'addr2line'           => 'addr2line',

     # 'file-linux'          => "file",
     # 'file-sun'            => "$sbin/file-sun",

     # 'file-pcsolaris'      => "file",
     'file' => 'file',

     # fundamental files and values

     'asm-dictionary-ppc'  => "$data/ppchelp.doc",
     'asm-dictionary-x86'  => "$data/x86help.doc",
     'asm-dictionary-linux'  => "$data/x86help.doc",

     'list-all-gdb'               => \&list_of_gdb_exec,
     'parameterize'               => \&parameterize,
     # 'umake-script-file'          => '/emc/ucode/Linux-2x-i686/bin/umake',
     # 'numake-script-file'         => '/emc/ucode/ucbbp/numake',

     # 'qa-names-file-win32'        => "\\\\starfleet\\eng\\qacode\\anatmain\\SymDoc\\Symmremote 2.0\\ipQA.txt" ,
     # 'qa-names-file'              => "$data/qa_name_ip.txt" ,
     # 'symm-mf-setting-file'       => "$data/mfdb/symm-mf.dat",
     # 'symm-mf-setting'            => \&get_symm_mf_setting_win32,
     # 'symm-locale-file'           => "$data/symms.dat",
     # 'faq-pod-directory'          => "$share/doc/FAQ" ,

     'gallery-dir'                => "$gallery",
     'gallery-dir-win32'          => '',
     # 'swuchscript-dir'            => "$share/Swuch/Scripts",
     # 
     # 'swuch-cli-f7'               => "$data/idb.pm" ,
     # 'swuch-cli'                  => "$data/IDOC.pm",
     # 'swuch-cli-global'           => "$data/UDOC.pm",
     # 'swuch-cli-local'            => "$ENV{HOME}/.swuchinlines",

     # 'swuch-pse-cli'              => "$pse/pse-cli.pm",
     # 'swuch-pse-restrict'         => "$pse/pse-restrict.pm",
     # 'swuch-pse-warnings'         => "$pse/pse-warnings.pm" ,
     # 'swuch-pse-cli-cached-win32'       => "$data/pse-cli.pm",
     # 'swuch-pse-restrict-cached-win32'  => "$data/pse-restrict.pm",
     # 'swuch-pse-warnings-cached-win32'  => "$data/pse-warnings.pm" ,

     # "sgdb-info-host"             => 'sgdb.info' ,
     # "sgdb-info-port"             => 0x59cc,
     # "sgdb-info-query"            => \&sgdb_info_query,
     # 'elf-data-file'              => "$data/flu.dump" ,
     # 'syrenhost'                  => 'syren-3.lss.emc.com',
     'cleanup'                    => \&local_cleanup,
     'parse-aux-info'             => \&parse_aux_info,
     'parse-func-info'            => \&parse_func_info,
     # 'symmevent'                  => "$sbin/../symmevent",
     # 'qa-dirs-cache-file'         => "$data/qa.common.dir.cached",
     ) ;

our $target_type = '' ;
my $oscutename = get_os_cute_name() ;
my $os2ndname ;
if ($oscutename =~ /^(.*)-[\d\.]+$/) {
    $os2ndname = $1 ;
}
sub local_config {

    my $key = shift ;
    my $val ;
    for ( "$key-$oscutename-$target_type",
          "$key-$oscutename",
          ( $os2ndname ?
            ( "$key-$os2ndname-$target_type",
              "$key-$os2ndname",
            ) : () ),
          "$key"
        ) {

        exists $local_config{ $_ } or next ;
        $val = $local_config{ $_ } ;
        last ;
    }
    return  $val unless        ref $val ;
    return @$val if 'ARRAY' eq ref $val ;
    return %$val if 'HASH'  eq ref $val ;
    return &$val if 'CODE'  eq ref $val ;
    warn "what is ref val? " . ref $val ;
    return  $val ;
}

sub list_of_gdb_exec {
    grep { -x  } glob "$sbin/gdb*"
}

my %get_cvs_root_tag ;
sub get_cvs_root_tag ($$) {
    my ($dir, $source, $dat) = @_ ;
    if (! $get_cvs_root_tag{$dir}  and
        -e (my $sc = "$dir/.scinfo" ) ) {
# Directory=.
# Root=:pserver:anonymous@ucodecvs.lss.emc.com:2401/home/cvsroot
# Repository=symm
# Tag=-D '07/02/2004 14:03:17 EDT'
# Directory=shc
# Root=:pserver:anonymous@brooks.lss.emc.com:2706/ucodecvs/cvsroot_2
# Repository=shc
# Tag=-D '07/02/2004 14:03:17 EDT'
        open F, $sc or return "can't open $sc: $!" ;
        while (<F>) {
            /^Directory =\s*(.*?)\s*$/x and $dat = $1 || '.' ;
            /^Root      =\s*(.*?)\s*$/x and $get_cvs_root_tag{$dir}{$dat}[0] = $1 ;
            /^Tag       =\s*(.*?)\s*$/x and $get_cvs_root_tag{$dir}{$dat}[1] = $1 ;
            /^Repository=\s*(.*?)\s*$/x and $get_cvs_root_tag{$dir}{$dat}[2] = $1 ;
        }
        close F ;
    }
    if (my $t = $get_cvs_root_tag{$dir}) {
        $dat  = $t -> {'.'} ;
        foreach my $key ( sort {length} keys %$t) {
            next if index $source, "$key/" ;
            last if $dat = $t ;
        }
        if ($dat) {
            return
              ( $dat ->[0] || ':pserver:anonymous@ucodecvs.lss.emc.com:2401/home/cvsroot' ,
                $dat ->[1] , # || get_cvs_root_tag_guess_tag($dir),
                $dat ->[2] || 'symm'
              )
        }
    }
    # plan B
    my $subdir = File::Basename::dirname $source ;
    my $subfile = File::Basename::basename $source ;
    my $cvsdir;
    if (File::Spec->file_name_is_absolute($source)) {
        $cvsdir = "$subdir/CVS";
    } else {
        $cvsdir = "$dir/$subdir/CVS";
        unless (-d $cvsdir) {
            $cvsdir = "$dir/../$subdir/CVS";
        }
    }
    my $entries = "$cvsdir/Entries";
    my $rootfile = "$cvsdir/Root" ;
    my $repositoryfile = "$cvsdir/Repository" ;

    -T $entries or return "cvs: $entries: not a text file" ;

    my $rev ;

    foreach my $line ( qx( grep -w $subfile $entries ) ) {

        $line =~ m{^ / \Q$subfile\E / ([\d\.]+) / }x or next ;
        $rev = $1 ;
        last ;
    }
    return "cvs: could not find $subfile in $entries\n" unless $rev ;

    my $root = ':pserver:anonymous@ucodecvs.lss.emc.com:2401/home/cvsroot';
    if (open F, $rootfile ) {
        $root = <F> ;
        chomp $root ;
        $root =~ s/\:\w*\@/\:anonymous\@/ ;
        close F ;
    }

    my $repository = 'symm' ;
    if (open F, $repositoryfile ) {
        $repository = <F> ;
        chomp $repository ;
        close F ;
    }

    ($root, "-r$rev", $repository)
}

sub emc_find_cvs_file {

    my ($dir, $source , $target) = @_ ;

    my $cmd = local_config( "cvs" ) or return "can't determine cvs program" ;

    return if -e "$target/$source" ;

    my ($root, $tag, $repository) = get_cvs_root_tag($dir, $source) ;

    return $root unless $tag ;

    $cmd = join ' ', ( $cmd,
                       '-Q',
                       '-d', $root,
                       "co $tag -p ",
                       "$repository/$source",
                     ) ;
    # warn "cmd=$cmd\n" ;
    open CVS, "$cmd |"
      or return "can't open $cmd: $!" ;
    open F , "> $target/$source"
      or return "can't open $target/$source: $!" ;
    print F <CVS> ;
    close F ;
    close CVS ;

    return ;
}

sub emc_get_cvs_annotate {

    my ($source, $scratch, $dir ) = @_ ;

    my ($root, $tag, $repository) = get_cvs_root_tag($dir, $source) ;

    return $root unless $tag ;

    get_generic_annotate( $scratch, $tag, $root, $repository, $source )
}

sub cat($$) {
    my ($l, $f) = @_ ;
    chomp $l ;
    open  F, ">$f" or return "Error: can't open '$f': $!" ;
    print F $l, "\n" ;
    close F ;
    return
}

sub get_generic_annotate {

    my ($scratch, $tag, $root, $repository, $source ) = @_ ;

    # CVS wrapper annotation is brocken, comment it out for now
    #my $f = get_cvs_wrapper_annotate($scratch, $tag, $root, $repository, $source);
    #if (defined $f) {
    #    return $f;
    #}
    get_cvs_annotate($scratch, $tag, $root, $repository, $source);
}

sub get_cvs_wrapper_annotate {

    my ($scratch, $tag, $root, $repository, $source) = @_ ;

    my ($d, $f) = $source =~ /^(?:(.*)\/)?(.*?)$/ ;

    my $target = "$scratch/$f.annotate" ;
    my ($rep,$t) = split(/\//, $repository, 2);
    my $cmd = local_config( "cvs" ) or return "Error: can't determine cvs program" ;

    $cmd = join ' ', ( $local_config{ "chdir-luncher" },
                       $scratch,
                       $cmd,
                       '-Q',
                       '-d', $root,
                       "annotate -C -p$rep $tag",
                       $source,
                       '>',
                       $target
                     ) ;

    print  $cmd, "\n" if $ENV{SGDBTK_DEBUG_PATCH};
    system $cmd ;
    if ($? == 0) {
        return $target;
    }
}

sub get_cvs_annotate {

    my ($scratch, $tag, $root, $repository, $source ) = @_ ;

    my ($d, $f) = $source =~ /^(?:(.*)\/)?(.*?)$/ ;

    my $target = "$scratch/$f.annotate" ;
#     return if -e $target ;

    my $cvsdir = "$scratch/CVS" ;
    -d $cvsdir or mkdir $cvsdir or return "Error: can't open make '$cvsdir': $!" ;

    $_ = cat $root           => "$cvsdir/Root"       and return $_ ;
    $_ = cat "$repository" => "$cvsdir/Repository" and return $_ ;
    $_ = cat "/$f/2.2/Mon Aug  6 16:23:04 2001//" => "$cvsdir/Entries" ;

    my $cmd = local_config( "cvs" ) or return "Error: can't determine cvs program" ;

    $cmd = join ' ', ( $local_config{ "chdir-luncher" },
                       $scratch,
                       $cmd,
                       '-Q',
                       '-d', $root,
                       "annotate $tag",
                       $f,
                       '>',
                       $target
                     ) ;

    print  $cmd, "\n" if $ENV{SGDBTK_DEBUG_PATCH};
    system $cmd ;

    return $target;
}

sub parameterize {

    my %options = map { ref $_ ? $_ : /^-?(.*)$/o} @_ ;

    my ($major, $minor, $emul, $targetip, $dirname, $targettype ) =
        @options{ 'major', 'minor', 'emul', 'targetip', 'director', 'target-type' } ;

    # 1. determine symbol-file

    if (! exists $options{ 'file' } ) {

        # 1.a. try to determine the symbol file by it's minor release

        if    ($major && $minor && $emul ) {
            $options{ 'file' } =
                "/disks/listing.$major/${emul}_${major}_${minor}.elf-gdb" ;
        }

        # 1.b. try by it's ip address

        elsif ( $targetip && $dirname ) {
            warn "Internal: targetip not supported. Yet." ;
        }

        # 1.c. try by ip and emul kludge

        elsif ( $targetip && $emul ) {
            warn "Internal: targetip not supported. Yet." ;
        }
    }

    # 2. verify target cpu type

    unless ( $targettype ) {

        my $fi = $options{ 'file' } ;
        my $filex = local_config( 'file' ) ;

        my $ft = ($fi && -B $fi ? qx( $filex $fi ) : '' ) || '' ;

        while ( $ft =~ /link\d+to\s+(\S+)/ ) {
            # follow the link ..
            $fi = $1 ;
            $ft = (-B $fi ? qx( file $fi ) : '' ) ;
        }

        if   (! $ft ) {

            if ( exists $options{ 'default-target' } ) {
                $targettype = $options{ 'default-target' } ;
            }
            elsif ($fi and
                   $fi !~ /\.elf(?:-gdb)?/ and
                   $fi !~ m!/\d(\d)\w\w[\._][^/]*$! and
                   $1 > 3
                  ) {
                #                 3   4   5   6   7   8   9
                $targettype = (qw/m68 m68 ppc ppc ppc x86 x86_64/)[$1 - 3] ;
            }
            else {
                $targettype = $oscutename ;
            }
        }
        elsif ( $ft =~ /powerpc/ig ) {

            $targettype = 'ppc' ;
        }
        elsif ( $ft =~ /m68|68000/ig ) {

            $targettype = 'm68' ;
        }
        elsif ( $ft =~ /x86\-64/i) {
            $targettype = 'x86_64' ;
        }
        elsif ( $ft =~ /\b80386\b/ ) {
            $targettype = 'x86' ;
        }
        else {

            $targettype = $oscutename ;
        }
    }
    # 3. determine 'execfile'

    if (! exists $options{ 'execfile' } and $targettype ) {

        $target_type = $targettype ; # kludge!

        $options{ execfile } = local_config ('gdb') ;
        # rare kludge
        $options{ execfile } = local_config ('gdb53') if
          $targettype eq 'ppc' and $options{ file } and
          $options{ file } =~ m{/disks/listings.(\d\d\d\d)/} and
            $1 <= 5669;
    }

    # 4. set syren_fix_table name

    $options{ 'syren_fix_table' }     ||= $local_config{ "syren_fix_table-$targettype" } ;

    # 5. set gdb parameters

    # $options{ 'params' }              ||= $local_config{ "gdb-exec-parameters" } ;
    # obsolete: done in GdbExt (Devel::GDB)

    # 6. set asm dictionary (well, it is a ppc feature)

    $options{ 'asm-dictionary' }      ||= $local_config{ "asm-dictionary-$targettype" } ;

    # 7. set target-type

    $options{ 'target-type' }         ||= $target_type = $targettype ;

#     # 8. remotegui mode
#     $options{ 'remotegui' }           ||= $remotegui ;

    (%options) ;
}

sub get_os_cute_name {

    my $ostype = $^O ;

    if ( ! $ostype ) {

        warn "Could not determine OS type\nNote that some features will not work!\n" ;
        return '' ;
    }
    elsif ( $ostype =~ /linux/i ) {
        return 'linux-2.2' if qx/uname -r/ =~ /^2\.2/;
        return 'linux' ;
    }
    elsif ( $ostype =~ /win32/i ) {
        return 'win32' ;
    }
    elsif ( $ostype =~ /solaris|sunos/i ) {

        return 'pcsolaris' if qx/uname -m/ =~ "i86pc";
        return 'sun-5.5.1' if qx/uname -r/ =~ '5.5.1';
        return 'sun' ;
    }

    warn "unknown Operating System: $ostype\nNote that some features will not work!\n" ;
    '' ;
}


sub parse_func_info {
    my $elf = shift;
    my $readelf = local_config('readelf') or return 'Error: No readelf found';
    my @functions;
    open F, "$readelf -s $elf |" or return "can't execute readelf: $!";
    while ($_ = <F>) {
        # 14320: 000111f8   892 FUNC    LOCAL  DEFAULT    4 compare_emulation
        /^\s*\d+:\s*(\w+)\s+(\w+)\s+FUNC.*?\s(\w+)\s*$/ or
          #  13808: 00022788     0 NOTYPE  GLOBAL  DEFAULT    5 analyze_this
          /^\s*\d+:\s*(\w+)\s+(\w+)\s+NOTYPE\s+GLOBAL\s+DEFAULT\s+\d+\s+(\w+)/
            or next;
        # $1 - address, $2 - length, $3 - name
        push(@functions,[hex($1),$2,$3]);
    }
    close F;
    return \@functions;
}

'END'

